home *** CD-ROM | disk | FTP | other *** search
/ Light ROM 1 / LIGHT-ROM 1 (Amiga Library Services)(1994).iso / ffdisks / d963.lha / SIOD / scm / err-stack.scm < prev    next >
Text File  |  1993-08-17  |  2KB  |  75 lines
  1.  
  2. Evaluation took 1960 milliseconds (0 in gc) 0 cons work
  3. #t
  4. >> define err-stack)
  5.  
  6. Evaluation took 40 milliseconds (0 in gc) 0 cons work
  7. err-stack
  8. >> (define (on-error p)
  9.            (if (proc? p)
  10.                (set! err-stack (cons p err-stack))
  11.                (error "proc is needed")))
  12.  
  13. Evaluation took 40 milliseconds (0 in gc) 8 cons work
  14. on-error
  15. >> (define (new-error s)
  16.            (while err-stack
  17.                   ((car err-stack))
  18.                   (set! err-stack (cdr err-stack))))
  19.  
  20. Evaluation took 40 milliseconds (0 in gc) 8 cons work
  21. new-error
  22. >> (transcript-off)
  23.  
  24. Evaluation took 880 milliseconds (0 in gc) 0 cons work
  25. #t
  26. >> define (with-output s p)
  27.            (let ((o (fluid output-port)))
  28.                 (set! s (open-output-file s))
  29.                 (set! (fluid output-port) s)
  30.                 (on-error (lambda () (close-output-port s)
  31.                                      (set! (fluid output-port) o)))
  32.                 (p)
  33.                 (set! (fluid output-port) o)))
  34.  
  35. Evaluation took 40 milliseconds (0 in gc) 8 cons work
  36. with-output
  37. >> (transcript-off)
  38.  
  39. Evaluation took 899 milliseconds (0 in gc) 0 cons work
  40. #t
  41. >> define (unerror p)
  42.            (set! err-stack (delq! p err-stack)))
  43.  
  44. Evaluation took 40 milliseconds (0 in gc) 8 cons work
  45. unerror
  46. >> (transcript-off)
  47.  
  48. Evaluation took 980 milliseconds (0 in gc) 0 cons work
  49. #t
  50. >> define (with-output s p)
  51.            (let ((o (fluid output-port))
  52.                  (e (lambda () (close-output-port s))))
  53.                 (set! (fluid output-port) (open-output-file s))
  54.                 (p)
  55.                 (close-output-port (fluid output-port))
  56.                 (set! (fluid output-port) o)))
  57.  
  58. Evaluation took 40 milliseconds (0 in gc) 6 cons work
  59. with-output
  60. >> (define (with-output s p)
  61.            (letrec ((o (fluid output-port))
  62.                     (f (open-output-file s))
  63.                     (e (lambda () (close-output-port f)
  64.                                   (set! (fluid output-port) o))))
  65.                 (set! (fluid output-port) f)
  66.                 (on-error e)
  67.                 (p)
  68.                 (close-output-port f)
  69.                 (set! (fluid output-port) o)
  70.                 (unerror e)))
  71.  
  72. Evaluation took 40 milliseconds (0 in gc) 6 cons work
  73. with-output
  74. >> (transcript-off)
  75.